{-# OPTIONS -Wall #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  DirectoryMetrics.ResolvedSyntax
-- Copyright   :  (c) Stephen Peter Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  experimental
-- Portability :  to be determined
--
-- /Hier/-archical syntax - nesting.
--
-----------------------------------------------------------------------------


module DirectoryDiff.ResolvedSyntax 
  (
    Atom
  , Resolved(..)
  , Directory(..)
  , File(..)            -- re-export
  , DateTime(..)        -- re-export


  , resolve

  , fileNames
  , dirNames
  , resolvedDateTime

  , atoms

  ) where


import qualified DirectoryDiff.FlatSyntax as F
import DirectoryDiff.FlatSyntax ( DateTime(..) )

import Data.List ( stripPrefix )
import Data.Monoid

type Atom = String

data Resolved = Resolved
    { res_path_to_root          :: String 
    , res_directories           :: [Directory]
    , res_files                 :: [File]
    }
  deriving (Eq,Ord,Show)

data Directory = Directory
    { dir_path_from_root        :: String
    , dir_datetime              :: DateTime
    }
  deriving (Eq,Ord,Show)

data File = File
    { file_path_from_root       :: String
    , file_datetime             :: DateTime
    , file_size                 :: Integer
    }
  deriving (Eq,Ord,Show)


resolve :: [F.Directory] -> Either String Resolved 
resolve []        = Left $ "resolve - empty directory list."
resolve xs@(x1:_) = Right $ 
    Resolved { res_path_to_root          = root_prefix
             , res_directories           = dirs
             , res_files                 = files
             }
  where
    root_prefix     = F.dir_path_to x1
    (dirs,files)    = foldr mkD ([],[]) xs

    mkD d (accd,accf)  = 
        let rel_path = removePrefix root_prefix (F.dir_path_to d)
            dnew     = Directory { dir_path_from_root = rel_path
                                 , dir_datetime       = F.dirDateTime d }
            accf1    = foldr (mkF rel_path) accf (F.dirFiles d)
        in (dnew : accd, accf1) 
            
    mkF :: String -> F.File -> [File] -> [File]
    mkF rel_path f1 acc = fnew : acc
      where
        fnew = File { file_path_from_root = rel_path ++ '\\' : (F.file_name f1)
                    , file_datetime       = F.file_datetime f1
                    , file_size           = F.file_size f1
                    }


removePrefix :: String -> String -> String
removePrefix pre a = maybe pre id $ stripPrefix pre a


fileNames :: Resolved -> [Atom]
fileNames = foldr fn mempty . res_files
  where
    fn a xs = file_path_from_root a : xs

dirNames :: Resolved -> [Atom]
dirNames = foldr fn mempty . res_directories
  where
    fn a xs = dir_path_from_root a : xs


resolvedDateTime :: Resolved -> DateTime
resolvedDateTime (Resolved { res_directories = dirs}) = go dirs
  where
    go (d:_ ) | dir_path_from_root d == "" = dir_datetime d
    go (_:ds)                              = go ds
    go []                                  = F.invalid_date_time



atoms :: FilePath -> [Atom]
atoms [] = []
atoms xs = case pivot (/= '\\') xs of
             Left as -> if null as then [] else [as]
             Right (a,_,as) -> a : atoms as

pivot :: (a -> Bool) -> [a] -> Either [a] ([a],a,[a])
pivot test xs = let (ys,zs) = span test xs in case zs of
                  (a:as) -> Right (ys,a,as)
                  []     -> Left ys
                       
